#|___________________________________________________________________ 
 | 
 |        ViSta - The Visual Statistics System
 |        Copyright (c) 1991-2001 by Forrest W. Young
 |        www.visualstats.org  forrest@visualstats.org
 |
 |        see comment in INIT.LSP
 |_________________________________________________________________ 
 |# 



(defun open-window 
    (&optional (cant-b-x 4) (y 24) 
               (w (first (effective-screen-size))) 
               (h (second (effective-screen-size))))
  (hidemainwindow)
  (mainwindow cant-b-x y  w h)
  (showmainwindow)
  (listener 2 0 w (- h 20)))

(defun open-default-window ()
  (hidemainwindow)
  (apply #'mainwindow 40 40 (floor (* 2/3 (screen-size))))
  (showmainwindow)
  (apply #'listener 4 24 (- (select (mainwindow) (list 2 3)) (list 8 46)))
  )

(defun strcat (&rest args) (apply #'concatenate 'string args))

(defun zero-button-dialog (text &optional title &key (width 400) (pause 0))
"Args: TEXT"
  (let* ((text (send text-item-proto :new text :SIZE '(350 40)))
         (dialog (send dialog-proto 
                       :new (list text) 
                       :title (if title (string-upcase title) " ")
                       :size (list width 40))))
    (pause pause)
    dialog))



(defun please-wait (text &key (pause 0) (close nil) (show-time nil))
"Args: text &key (pause 0) (close nil) (show-time nil)
Displays text in a button-less modeless dialog box. By default will show forever and will be closable by the user. Must be sent the :remove message to remove, unless :close is t, in which case the close box will close it. Show-time and pause control the timing of events."
  (when (not (boundp '*please-wait*)) 
        (setf *please-wait* nil)
        (setf *please-waiter* nil))
  (when *please-waiter*
        (setf *please-wait* *please-waiter*))
  (if *please-wait* 
      (send (first (send *please-wait* :items)) :text text)    
      (progn
       (setf *please-wait* (zero-button-dialog text "Please Wait" :pause pause))
       (setf *please-waiter* *please-wait*)))
  (defmeth *please-wait* :text () 
    (send (first (send self :items)) :text text))
  (defmeth *please-wait* :remove () 
    (call-next-method) 
    (setf *please-wait* nil))
  (if close 
      (defmeth *please-wait* :close ()
        (send self :remove))
      (defmeth *please-wait* :close ()))
  (send *please-wait* :show-window)
  (when pause (pause pause))
  (when show-time
       (let ((start-time (/ (get-internal-real-time)
                            internal-time-units-per-second))
              (current-time))
         (defmeth *please-wait* :loop ()
           (loop
            (setf current-time (/ (get-internal-real-time)
                                  internal-time-units-per-second))
            (when (> (- current-time start-time) show-time) (return)))
           (send *please-wait* :remove))
         (send *please-wait* :loop)))
  *please-wait*)



(defun wait-for-file-update (file-name)
  (let* ((original-file-date (file-write-date file-name))
         (new-file-date)
         (current-new-file-length)
         (previous-new-file-length 0)
         )
    (setf i 0)
    (loop
     (setf new-file-date (file-write-date file-name))
     (cond 
       ((= original-file-date new-file-date)
        (pause 60)
        (setf i (1+ i))
        (Please-wait 
           (format nil "INSTALLING VISTA: Installation has taken ~d seconds." i)))
       (t
        (with-open-file 
         (f "xlisp.wks")               
         (loop 
          (pause 60)
          (setf i (1+ i))
          (setf current-new-file-length (file-length f))
          (format t "~d ~d ~d ~%" i 
                  new-file-date 
                  current-new-file-length)
          (Please-wait 
           (format nil "INSTALLING VISTA: Have Installed ~d Bytes." 
                   current-new-file-length))
          (cond 
            ((= current-new-file-length 
                previous-new-file-length)
             (return))
            ((setf previous-new-file-length current-new-file-length)
             )))
         (return)))))))

(defun elapsed-time (&optional (time (* 60 (run-time))))
  (let* ((seconds (floor (rem time 60)))
         (minutes (floor (rem (/ time 60) 60)))
         (hours (floor (/ time 3600)))
         (hours-string (if (< hours 1) "" (format nil "~a:" hours)))
         (seconds-string (format nil (if (< seconds 10) ":0~a" ":~a")
                                 seconds))
         (minutes-string 
          (format nil (if (< hours 1) (format nil "~a" minutes)
                          (if (< minutes 10) (format nil "0~a" minutes)
                              (format nil "~a" minutes)))))
         )
    (strcat hours-string minutes-string seconds-string)))

(defun written-time (time-in-decimal-minutes)
  (let* ((time time-in-decimal-minutes)
         (hours   (floor (mod (/ time 60) 60)))
         (minutes (floor time))
         (seconds (floor (* 60 (rem time 1))))
         (60ths   (round (mod (* 60 time) 60)))
         (str)
         )
    (when (> hours 0) (setf str (format nil "~d hours, " hours)))
    (when (or (> hours 0) (> minutes 0))
          (setf str (strcat str (format nil "~d minutes, " minutes))))
    (setf str (strcat str (format nil " ~d and ~d/60 seconds" seconds 60ths)))
    str))

(defun run-time-string ()
  (let* ((min-decimal (multiple-value-list (floor (run-time))))
         (minutes (first min-decimal))
         (seconds (round (* 60 (second min-decimal)))))
    (format nil "~a:~a" minutes seconds)))


(defun run-time (&key long-hand wordy) 
"Arg: wordy
Returns run time in minutes. Expressed in words when WORDY is true."
  (let ((time  (/ (get-internal-real-time) internal-time-units-per-second 60) 2))
    (if long-hand (written-time time) time)))

(defun remote-load-data (&optional file run-vista)
  (let* ((in-dir (get-working-directory))
       	 (home-dir (set-working-directory (strcat *startup-path* "..")))
         )
    (when run-vista (system "vista.exe"))
    (when (wait-for-vista-op)
          (setf *dde-connect-number* (dde-connect "xlisp-stat"))
          (when file
                (dde-client-transaction dde-connect-number :data "(load-data file)")
                (dde-client-transaction dde-connect-number :type :request :item "value")))
    (set-working-directory in-dir)
    file))

(defun wait-for-vistaop ()
  (let* ((vista-op (msw-get-profile-string "ViSta" "ViStaOp" *home-ini-file*))
         (initial-time (run-time))
         )
    (loop
     (when (> (- (run-time) initial-time) 1) 
           (format t "> ; timed out~%> ") 
           (setf flag nil) 
           (return))
     (when (equal "yes" (string-downcase vista-op))
           (please-wait (format t "ViSta Operational"))
           (setf flag t)
           (return)))
    flag))